C*** MSSUB.F4 --- SUBROUTINES FROM MS.F4
C***  ESPOS, CENTXT, CONTXT,MORCEN, GETMS

	SUBROUTINE ESPOS(RLINE)
C FOR 'ED' AND 'ES' COMMANDS
C** CALL BOX, EXCH
	COMMON /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
	COMMON R2,JA,CENTR,J2,RJQ(20),J3,J4 /ALF/I1,I2
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
	EQUIVALENCE (R4,RJQ(2)),(R3,RJQ(1))
	IF(I2.NE.LSS)GO TO 1490
	CALL EXCH(R2,R3)
	J3=R3
C 'ES' IS "EDIT, STAFF, POS., CODE"
C 'ED' IS "EDIT, POS., STAFF, CODE"
1490	CALL BOX(-1,R2)
	IF(J4.EQ.0)KED=-1
	RITEM=R4
C  FOR 'ED POS., STF., CODE#'   (STF > 7 = ALL STAVES)
	IF(J3.GT.7)KED=-2
	RLINE=R2
	R2=R3
	END

C  NEXT FOR CENTERING TEXT.  P10>1
	SUBROUTINE CENTXT(RD)
	COMMON /PTR/KWDS(1) /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1)
	COMMON R2,JA,CENTR,J2,RJQ(20)  /LIMIT/LIMIT,ITEM,L
	EQUIVALENCE (R10,RJQ(8)),(R3,RJQ(1))
	RB=0
	JX=KWDS(L+1)
1960	L=L+1
	K=KWDS(L)
	RB=RB+RN(K+9)
C  ADD SPACE NEEDED
	K=KWDS(L+1)
	IF(RN(K+1).NE.16.)GO TO 1970
	IF(RN(K).EQ.8.)GO TO 1960
C GO BACK IF MORE LETTERS TO COME
1970	R3=R10-(RB-3.4)*RD*RSTJ2/2.
C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
	R10=0
	IF(RN(JX).EQ.8)RN(JX+10)=0
	RN(JX+3)=R3
C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
	END

	SUBROUTINE CONTXT
C FOR TEXT CONTINUATION
	COMMON /PTR/KWDS(1) /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1)
	COMMON R2,JA,CENTR,J2,RJQ(20) /LIMIT/LIMIT,ITEM,L
	COMMON /RRJJ/RJJ2,RJJ(20),JJA
	EQUIVALENCE (R3,RJQ(1)),(R4,RJQ(2)),(R5,RJQ(3))
1980	K=KWDS(L)
	R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
C  AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
	R4=RN(K+4)
	R5=RN(K+5)
	R2=RN(K+2)
	J2=R2
	L=KWDS(L+1)
	DO 1990 JJA=3,5
1990	RN(L+JJA)=RJQ(JJA-2)
	RN(L+2)=R2
	END

	SUBROUTINE MORCEN(ICB)
	IMPLICIT INTEGER(A-Q,S-Z)
	REAL STFF,CENTR
	COMMON  /STF/RSTFAC(0/7),RSTJ2
	COMMON  /RRJJ/RJJ2,RJJ(20),JJA
	COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
	1 (R6,RJQ(4)),(R4,RJQ(2)),(R7,RJQ(5)),(R3,RJQ(1)),
	4 (R11,RJQ(9)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R13,RJQ(11))

2010	RJ3=R3
	JJA=JA
	IF(R8.NE.0)GO TO 2020
	IF(JA.EQ.1)R8=999.
C  999=0 FOR STEM EXTENSIONS.
C  USES ONLY 10 PARAMETERS BEYOND JA, J2
2020	CALL MSSLUP
	IF(JA.NE.6)GO TO 2040
2030	CALL HOMER

2040	IF(R13.EQ.0)RETURN
	RD=R11
	IF(ICB.EQ.0)GO TO 2050
C *** ICB = CENTER-BIG  I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VAR
	X=ICB+10
	IF(ICB.LT.-1)ICB=X
C CBV  NOW=-4, CHV AND CTV =-10
	IF(RD.EQ.0)R11=ICB
	IF(JA.NE.4)GO TO 2045
	IF(ICB.GE.0)GO TO 2050
	CALL DASHES(ITEM,R2,RJQ)
C SUBR. DASHES WILL CENTER DASH BETWEEN TO WORDS OR SYLLABLES. (TYPE 'CD')
	GO TO 2060
2045	IF(JA.NE.5.OR.ICB.GT.0)GO TO 2050
C *** CV = SET CURVE OF SLUR. (FOR USE AFTER SPACE CHANGES, ETC.)
	R7=RCURVE(R3)
CC      R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
C SAME FORMULA AS FOUND IN SLURZ ROUTINE.  FUNCTION CURVE IS IN LOOP
CC      IF(R7)RB=-RB
CC DONE IN 'RCURVE'***  R7=RB
	RJ7=R7
	IF(X.GT.0)GO TO 2060
	GO TO 2060
2050	CALL HOMER
2060	ICB=0
	R11=RD
C  R11 GETS CHANGED IN 'HOMER'
C RSTCEN IS FOR CENTERING WHOLE RESTS.
	IF(JA.EQ.10)R3=R3+RSTJ2
	IF(JA.NE.9)RETURN
	IF(J5.GT.3)RETURN
	CALL NOZERO(R6)
	R3=R3+RSTJ2+2.*RSTJ2*R6
C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
C  P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHR
	END

	SUBROUTINE GETMS(KG)
	IMPLICIT INTEGER(A-Q,S-Z)
	REAL STFF,CENTR
	DIMENSION LST(18),DP(0/7)
	COMMON /DL/X22,SAVER,NAME,EXT,IOLD
	COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
	1 /STF/RSTFAC(0/7),RSTJ2 /IDEV/IDEV,CHNG 
	2  /POSI/STFF(0/7),JJ2,IPOS  /ALF/INP(72)
	3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
	5 /PTR/PWDS(350) /MKX/MK1,MK2,LESS,IGT,MK(5),MINUS
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
	2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM 
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO  /DPTR/WDS(350)
	EQUIVALENCE (J3,JQ(1)),(I2,INP(2)),(I1,INP(1))
	1,(R4,RJQ(2)),(R5,RJQ(3)),(R8,RJQ(6))
	DATA PLUS/'+'/,ITMP/'TMP'/,MS/'MS'/,IZERO/'0'/,N99/'99'/

C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY;
	IF(KG.NE.0)GO TO 2250
2220	J2=0
	IF(I.EQ.1)GO TO 2230
	L=NAME
	X=EXT
CC	IF(I2.EQ.IBLA)GO TO 2110
	IF(I2.NE.IBLA)GO TO 1
	KG=1
	RETURN
1	J2=-1
	I2=(I2-IZERO)/536870912
C TURN ASCII INTO INTEGER.
	IF(I2.GT.9.OR.I2.LT.0)GO TO 2230
C VERT. STEPS PER INCH = 23.9 (CONSIDER STAFF SIZE FACTOR TOO)
	R2=I2
	J2=1
C  'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
C 'Gn'=GET MORE AND PUT IT ON STAFF n AT POS. OF STAFF 0'S P8.
C ANYTHING AFTER 'G' BUT A NUMBER IS TAKEN AS 'GM'.
2230	I1=-1
	CALL NAMEXT(INP,NAME,EXT)
C  NOW TYPE 'G NAME' OR 'GM NAME'
	IF(NAME.NE.IBLA)GO TO 2250
2240	IF(K.NE.PLUS)GO TO 2245
C NOW NEXT-TO-LAST LETTER IS MOVED UP, LAST LETTER IS RESET TO 'A'
	NAME=((NAMZ+J3).AND."777777777400).OR."202
C   .AND.ETC ZEROS LAST 8 BITS, .OR."202 PUTS IN 'A'
	NAMZ=NAME
	K=0
	GO TO 2265
240	KG=4
700	FORMAT(72A1)
	RETURN
2245	CALL TYPSTR(' NAME.EXT?  ')
	READ(IDEV,700,END=240)INP
C GO PUT A1'S INTO A5, ETC.
	CALL NAMEXT(INP,NAME,EXT)
	IF(NAME.EQ.IBLA)GO TO 2270
	IF(NAME.NE.N99)GO TO 2250
C TYPE '99' TO BACK OUT OF 'SAVE'.
	NAME=L
	EXT=X
130	KG=2
	RETURN
2250	IF(I1.NE.LESS)GO TO 2260
	IDEV=5
	GO TO 2240
2260	CALL LO2UP(NAME)
	CALL LO2UP(EXT)
	K=NAME
	JA=2
	J3=256
	IF(K.NE.MINUS)GO TO 2263
	K=PLUS
	JA=-JA
	J3=-J3
2263	IF(K.EQ.PLUS)NAME=NAMZ+JA
C NAME='+' WHEN "NX" HAS BEEN TYPED. (UPS LAST LETTER OF FIVE TO NEXT)
2265	IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2270	JA=-1
C  -1 IS FOR 8852+3
2280	J=ITEM+1
	IF(NAME.NE.IBLA)GO TO 2290
C***	CALL GETEXT('TMP','MS ')
C****	CALL INMUS('TMP','MS',RN(I),PWDS(J),RSTFAC)
	K=ITMP
	JJ2=MS
	GO TO 2300
C***2290	CALL GETEXT(NAME,EXT)
C**** 2290	CALL INMUS(NAME,EXT,RN(I),PWDS(J),RSTFAC)
2290	K=NAME
	JJ2=EXT
2300	CALL INMUS(K,JJ2,RN(I),PWDS(J),RSTFAC)
    	IF(J2.EQ.0)GO TO 2310
	NAME=L
	EXT=X
C ABOVE GETS BACK ORIGINAL NAME WITH 'GM' AND 'Gn'
2310	RSTF=0
	NAMZ=NAME
C  SAVE THE NAME FOR NX OR '+' ROUTINE (GOES UP THE ALPHABET)
C***	CALL EXTIN(RSTFAC,128)
C***	CALL EXTIN(PWDS(J),JJ2)
C***	CALL EXTIN(RN(I),IPOS)
	ITEM=ITEM+JJ2-2
	IF(J2)2350,2320,2330
CC      IF(I2.EQ.IM)GO TO 2203
C J2=-1,1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.****
2320	IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
	I=IPOS
	IF(RSTF.EQ.0)GO TO 1320
C  (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
	CALL EXTIN(ST,4302)
	CALL DPYNEW
	GO TO 130

2330	DO 2340 K=1,ITEM
	IF(RN(PWDS(K)+1).NE.8)GO TO 2340
	J3=PWDS(K)
	IF(RN(J3+2).NE.0)GO TO 2340
	R8=RN(J3+8)
C ASSUMES SPACE INFO IS IN P8.  GET IT.
C NEXT FOR VERTICAL SPACING OF NEW STAFF TO BE READ.
	R5=23.9/RSTFAC(0)
	R3=.73*R2
C INCHES BETWEEN STAVES=.73
	R4=(R8-R3)*R5
C R4=CHANGE FROM NORMAL POSITION FOR INCOMING STAFF.
	GO TO 2350
2340	CONTINUE
C IF NO STAFF 0 WAS FOUND R4=0
	R4=0
2350	M=I-1
	DO 2360 K=J,J+JJ2-2
	PWDS(K)=PWDS(K)+M
	IF(J2.LE.0)GO TO 2360
C NEXT FOR GET-MORE AND PUT ON STAFF #R2
	J3=PWDS(K)
	RN(J3+2)=R2
	IF(RN(J3+1).NE.8)GO TO 2360
	RN(J3+4)=R4
C SET HEIGHT OF STAFF - DEPENDANT UPON P8 OF STAFF 0.
CCC     IF(RN(J3).GE.6)RN(J3+8)=0
C ZERO SPACING PARAM IN UPPER STAVES.
2360	CONTINUE
1320	KG=3
	END